Shareware Grab Bag/Shareware Grab Bag.iso/001/yahtzee.arc/YAHTZEE.BAS

BASIC Source File | 1985-09-27 | 21KB | 643 lines

0 GOTO 65000
1 '
1000 '     YATZEE
1010 ' ORIGINAL BY JL HELMS & MF PEZOK FOR CCII
1020 ' CORONADO, CA
1030 ' ADAPTED TO IBM PC BY PATRICK LEABO
1040 ' TUCSON, AZ
1050 '
1060 DEFINT A-Z
1070 DIM C(5):DIM K(18,7):DIM F(5):DIM A$(7)
1080 DIM S(6,5):DIM M(13),TN(6),DU(6):KEY OFF:COLOR 5,3,1:WIDTH 80
1090 SCREEN 0,1:RESTORE 1150:FOR N= 1 TO 6:READ TN(N):NEXT
1100 COMMON MENU
1110 GOSUB 5090
1120 C1= 39:C2= 63:C3= 33:C4= 56
1130 GOSUB 4660
1140 CLS:GOSUB 4430
1150 DATA 49,51,53,54,56,61
1160 GOSUB 6820:REM  draw yatzee board
1165 COLOR 7,0
1170 RANDOMIZE VAL(RIGHT$(TIME$,2))
1180 LOCATE 25,1
1190 PRINT "HOW MANY PLAYERS?  ";:LOCATE ,,1:GOSUB 2090
1200 GOSUB 7100: N=ASC(KB$)-48
1210 IF N< 1 OR N> 5 THEN 1180
1220 IF N< 5 THEN GOSUB 6000
1230 IF CC= 1 THEN GOSUB 5480
1240 LOCATE 25,1:PRINT STRING$(60," ");:FOR A=1 TO N
1250 LOCATE 24,1:PRINT STRING$(60," ");:LOCATE 24,1
1260 PRINT "PLAYER NUMBER "A;" NAME PLEASE  ";
1270 GOSUB 2090:LINE INPUT;A$(A):IF A$(A)= "" THEN BEEP:GOTO 1250
1280 A$(A)=LEFT$(A$(A),9)
1290 NEXT A
1295 LOCATE 24,1:PRINT STRING$(60," ");:LOCATE 24,1
1300 IF CC= 1 THEN N= N+ 1:A$(N)= "IBM PC"
1310 LOCATE 23,1
1320 A= 0
1330 REM
1340 REM   NEXT ROLL PRESET
1350 REM
1360 A= A+ 1:IF A> N THEN A= 1
1370 H= 0:GOSUB 5340
1380 IF A= 0 THEN 4760
1390 IF K(18,A)= 2 THEN 1360
1400 LOCATE 23,1:PRINT STRING$(70," ");
1410 LOCATE 23,4* (A- 1)+ 14
1420 PRINT A$(A);
1430 REM
1440 REM   INITIAL ROLL
1450 REM
1460 H= H+ 1:MR= 0
1470 FOR B= 1 TO 5
1480 J= B- 1:C(B)= INT (6* RND (1)+ 1)
1490 DIE= C(B):F(B)= 0
1500 GOSUB 5250
1510 GOSUB 5530
1520 NEXT B
1530 IF A* CC= N THEN 2140
1540 REM
1550 REM  PLAYER SELECTS QTY TO ROLL
1560 REM
1570 GOSUB 7080
1580 IF H> 2 THEN 1940
1590 POKE 106,0:PRINT " HOW MANY DICE TO ROLL AGAIN? ";:LOCATE ,,1:GOSUB 2080:GOSUB 7100:F$=KB$:PRINT F$;:F=ASC(F$)-48:LOCATE ,,0
1600 IF F= - 1 THEN GOSUB 35000
1610 IF F< 0 OR F> 5 THEN 1570
1620 IF F= 0 THEN 1940
1630 IF F= 5 THEN 1430
1640 REM
1650 REM  PLAYER SELECTS DICE TO ROLL
1660 REM
1670 H= H+ 1
1680 GOSUB 7080
1690 FOR NN= 1 TO 4:F(NN)= 0:NEXT
1700 PRINT " ROLL WHICH";F;"DICE AGAIN   ";:LOCATE ,,1
1710 GOSUB 2090:FOR ND= 1 TO F:
1720 GOSUB 7100:F$=KB$::F(ND)= ASC(F$)- 48:GOSUB 2120:IF F(ND)= 0 AND  ND= 1 THEN  ND= F:GOTO 1740
1730 IF F(ND)< 1 OR  F(ND)> 5 THEN 1720
1740 PRINT F(ND);:NEXT
1750 X= 2:XF= 0
1760 FOR J= 1 TO F
1770 IF F= 1 THEN 1790
1780 IF F(J)= F(J+ 1)THEN X= 1
1790 IF F(1)= 0 THEN XF= 1
1800 NEXT J:IF XF= 1 THEN H= H- 1:GOTO 1570
1810 ON X GOTO 1680,1820
1820 REM
1830 REM  PLAYER ROLLS DICE AGAIN
1840 REM
1850 FOR B= 1 TO 4
1860 IF F(B)= 0 THEN 1920
1870 C(F(B))= INT (6* RND (1)+ 1)
1880 DIE= C(F(B)):J= F(B)- 1
1890 GOSUB 5250
1900 GOSUB 5530
1910 F(B)= 0
1920 NEXT B
1930 GOTO 1540
1940 REM
1950 REM   PLAY BOARD NUMBER
1960 REM
1970 GOSUB 7080
1980 PRINT " PLAY BOARD NUMBER?  ";:LOCATE ,,1:GOSUB 2080:GOSUB 7100:I$=KB$:I=ASC(I$)- 48:LOCATE ,,0:IF I> 9 THEN I= I- 7
1990 GOSUB 2120:IF I> 9 THEN PRINT CHR$ (I+ 55);:GOTO 2010
2000 PRINT I;
2010 IF I< 1 OR I> 13 THEN 1970
2020 IF I= 12 AND K(12,A)> - 1 THEN 2140
2030 IF K(I,A)= 0 THEN 2140
2040 LOCATE 24,1:BEEP
2050 PRINT "NO - NO - DUMMY - - TRY AGAIN";:FOR ND=1 TO 1500:NEXT:LOCATE 24,1:PRINT STRING$(60," ");
2060 LOCATE 25,1:PRINT STRING$(60," ");:LOCATE 25,1
2070 GOTO 1980
2080 REM  HIGH PITCH CLICK
2090 PLAY "L64T200N70":RETURN
2100 REM  GLISSANDO SOUND
2110 PLAY "MBt255MLL64O5CC#DD#EFF#GG#AA#B":RETURN
2120 ' LO PITCH CLICK
2130 PLAY "L64T200N46":RETURN
2140 REM
2150 REM  DICE LOGIC
2160 REM  CLEAR/SET S(M,K)
2170 REM
2180 FOR M= 0 TO 6
2190 FOR K= 0 TO 5
2200 S(M,K)= 0
2210 NEXT K
2220 NEXT M
2230 FOR J= 1 TO 5
2240 X= C(J):S(X,0)= S(X,0)+ 1
2250 P= S(X,0):S(X,P)= J
2260 NEXT J
2270 REM
2280 REM  SET S(0,K)=M SEQUENCE BY QTY
2290 REM
2300 X= 0
2310 FOR J= 5 TO 1 STEP - 1
2320 FOR M= 6 TO 1 STEP - 1
2330 IF S(M,0)< > J THEN 2350
2340 S(0,X)= M:X= X+ 1
2350 NEXT M
2360 NEXT J
2370 IF A* CC= N THEN 2740
2380 IF I> 6 THEN 2460
2390 REM
2400 REM  CHECK PLAYER BOARD 1-6
2410 REM
2420 GOSUB 6110
2430 IF X= - 1 THEN 2720
2440 K(I,A)= I* S(S(0,X),0)
2450 GOTO 3980
2460 REM
2470 REM  CHECK PLAYER BOARD 7-13
2480 REM
2490 ON I- 6 GOTO 2500,2520,2540,2560,2610,2650,2680
2500 IF S(S(0,0),0)< 3 THEN 2720
2510 GOSUB 6190:GOTO 3980
2520 IF S(S(0,0),0)< 4 THEN 2720
2530 GOSUB 6190:GOTO 3980
2540 IF S(S(0,0),0)< > 3 OR S(S(0,1),0)< > 2 THEN 2720
2550 K(9,A)= 25:GOTO 3980
2560 IF S(1,0)> 0 AND S(2,0)> 0 AND S(3,0)> 0 AND S(4,0)> 0 THEN 2600
2570 IF S(2,0)> 0 AND S(3,0)> 0 AND S(4,0)> 0 AND S(5,0)> 0 THEN 2600
2580 IF S(3,0)> 0 AND S(4,0)> 0 AND S(5,0)> 0 AND S(6,0)> 0 THEN 2600
2590 GOTO 2720
2600 K(10,A)= 30:GOTO 3980
2610 IF S(1,0)AND S(2,0)AND S(3,0)AND S(4,0)AND S(5,0)= 1 THEN 2640
2620 IF S(2,0)AND S(3,0)AND S(4,0)AND S(5,0)AND S(6,0)= 1 THEN 2640
2630 GOTO 2720
2640 K(11,A)= 40:GOTO 3980
2650 IF S(S(0,0),0)< > 5 THEN 2720
2660 IF K(12,A)= 0 THEN K(12,A)= 50:GOTO 3980
2670 K(12,A)= K(12,A)+ 100:GOTO 3980
2680 GOSUB 6190:GOTO 3980
2690 REM
2700 REM  SET PLAYER INVALID
2710 REM
2720 K(I,A)= - 1
2730 GOTO 3980
2740 REM
2750 REM  COMPUTER CHECKS
2760 REM
2770 I= 12
2780 IF S(S(0,0),0)= 5 AND K(12,A)= 0 THEN K(12,A)= 50:GOTO 3980
2790 IF S(S(0,0),0)= 5 AND K(12,A)> 0 THEN K(12,A)= K(12,A)+ 100:GOTO 3980
2800 I= 8
2810 IF S(S(0,0),0)= 4 AND K(8,A)= 0 THEN GOSUB 6190:GOTO 3980
2820 I= 9
2830 IF S(S(0,0),0)= 3 AND S(S(0,1),0)= 2 AND K(9,A)= 0 THEN K(9,A)= 25:GOTO 3980
2840 IF K(11,A)< > 0 THEN 2900
2850 I= 11
2860 IF S(1,0)AND S(2,0)AND S(3,0)AND S(4,0)AND S(5,0)= 1 THEN 2890
2870 IF S(2,0)AND S(3,0)AND S(4,0)AND S(5,0)AND S(6,0)= 1 THEN 2890
2880 GOTO 2900
2890 K(11,A)= 40:GOTO 3980
2900 IF K(10,A)< > 0 THEN 2970
2910 I= 10
2920 IF S(1,0)> 0 AND S(2,0)> 0 AND S(3,0)> 0 AND S(4,0)> 0 THEN 2960
2930 IF S(2,0)> 0 AND S(3,0)> 0 AND S(4,0)> 0 AND S(5,0)> 0 THEN 2960
2940 IF S(3,0)> 0 AND S(4,0)> 0 AND S(5,0)> 0 AND S(6,0)> 0 THEN 2960
2950 GOTO 2970
2960 K(10,A)= 30:GOTO 3980
2970 IF H< 3 THEN 3140
2980 I= 6
2990 IF S(6,0)> 2 AND K(6,A)= 0 THEN K(6,A)= 6* S(6,0):GOTO 3980
3000 I= 5
3010 IF S(5,0)> 2 AND K(5,A)= 0 THEN K(5,A)= 5* S(5,0):GOTO 3980
3020 I= 4
3030 IF S(4,0)> 2 AND K(4,A)= 0 THEN K(4,A)= 4* S(4,0):GOTO 3980
3040 I= 3
3050 IF S(3,0)> 2 AND K(3,A)= 0 THEN K(3,A)= 3* S(3,0):GOTO 3980
3060 I= 7
3070 IF S(S(0,0),0)> 2 AND K(7,A)= 0 THEN GOSUB 6190:GOTO 3980
3080 I= 2
3090 IF S(2,0)> 2 AND K(2,A)= 0 THEN K(2,A)= 2* S(2,0):GOTO 3980
3100 I= 1
3110 IF S(1,0)> 2 AND K(1,A)= 0 THEN K(1,A)= S(1,0):GOTO 3980
3120 I= 13:IF K(13,A)< > 0 THEN 3140
3130 IF C(1)+ C(2)+ C(3)+ C(4)+ C(5)> 19 THEN GOSUB 6190:GOTO 3980
3140 REM
3150 REM  CLEAR DICE NUMBER F(B)
3160 REM  COMPUTER
3170 REM
3180 FOR B= 1 TO 5
3190 F(B)= 0
3200 NEXT B
3210 REM
3220 REM  GET DICE CONTROL
3230 REM  COMPUTER
3240 REM
3250 H= H+ 1:IF H> 3 THEN 3840
3260 I= M(MR):IF I< > 0 THEN 3290
3270 MR= MR+ 1:IF MR> 13 THEN MR= 1
3280 GOTO 3260
3290 IF I= 12 AND K(12,A)> - 1 THEN 3330
3300 IF K(I,A)< > 0 THEN 3270
3310 IF I= 9 THEN 3440
3320 IF I= 10 OR I= 11 THEN 3560
3330 REM
3340 REM  GET DICE 1,2,3,4
3350 REM  COMPUTER
3360 REM
3370 M= 0:J= 1
3380 M= M+ 1:IF M> 4 THEN 3720
3390 K= S(0,M):IF K= 0 THEN 3720
3400 FOR L= 1 TO S(K,0)
3410 F(J)= S(K,L):J= J+ 1
3420 NEXT L
3430 GOTO 3380
3440 REM
3450 REM  GET DICE FH
3460 REM  COMPUTER
3470 REM
3480 M= 0:J= 1
3490 M= M+ 1:IF M> 4 THEN 3720
3500 K= S(0,M):IF K= 0 THEN 3720
3510 IF K> 1 THEN 3490
3520 FOR L= 1 TO S(K,0)
3530 F(J)= S(K,L):J= J+ 1
3540 NEXT L
3550 GOTO 3490
3560 REM
3570 REM  GET DICE LG/SM ST
3580 REM  COMPUTER
3590 REM
3600 M= 0:J= 1
3610 M= M+ 1:IF M> 4 THEN 3680
3620 K= S(0,M):IF K= 0 THEN 3680
3630 IF S(K,0)= 1 THEN 3610
3640 FOR L= 1 TO S(K,0)
3650 F(J)= S(K,L):J= J+ 1
3660 NEXT L
3670 GOTO 3610
3680 IF F(1)< > 0 THEN 3720
3690 L= INT (2* RND (1)+ 1)
3700 F(1)= 5
3710 IF L= 1 THEN F(1)= 1
3720 REM
3730 REM  COMPUTER ROLL AGAIN
3740 REM
3750 FOR B= 1 TO 4
3760 IF F(B)< 1 THEN 3810
3770 C(F(B))= INT (6* RND (1)+ 1)
3780 DIE= C(F(B)):J= F(B)- 1
3790 GOSUB 5250
3800 GOSUB 5530
3810 F(B)= 0
3820 NEXT B
3830 GOTO 2140
3840 REM
3850 REM  COMPUTER MUST SCORE
3860 REM
3870 MR= MR+ 1:IF MR> 13 THEN MR= 1
3880 I= M(MR):IF I= 0 THEN 3870
3890 IF K(I,A)< > 0 THEN 3870
3900 IF I> 6 THEN 3960
3910 GOSUB 6110
3920 IF X= - 1 THEN 3970
3930 IF K(I,A)< > 0 THEN 3870
3940 K(I,A)= S(I,0)* I
3950 IF K(I,A)< > 0 THEN 3980
3960 IF I= 13 AND K(13,A)= 0 THEN GOSUB 6190
3970 IF K(I,A)= 0 THEN K(I,A)= - 1
3980 REM
3990 REM  GET SCOREBOARD TOTALS
4000 REM
4010 FOR J= 14 TO 17
4020 K(J,A)= 0
4030 NEXT J
4040 FOR J= 1 TO 6
4050 IF K(J,A)< 0 THEN 4070
4060 K(15,A)= K(15,A)+ K(J,A)
4070 NEXT J
4080 IF K(15,A)> 62 THEN K(14,A)= 35
4090 FOR J= 7 TO 13
4100 IF K(J,A)< 0 THEN 4120
4110 K(16,A)= K(16,A)+ K(J,A)
4120 NEXT J
4130 K(17,A)= K(14,A)+ K(15,A)+ K(16,A)
4140 REM
4150 REM  PRINT SCORE
4160 REM
4170 GOSUB 2110
4180 COLOR 15,0
4190 FOR J= 1 TO 6
4200 IF K(J,A)< 0 THEN LOCATE J+1,4* (A- 1)+ 15:PRINT "  0";:GOTO 4230
4210 IF K(J,A)< 1 THEN 4230
4220 LOCATE J+1,4* (A- 1)+ 15:PRINT  USING"###";K(J,A);
4230 NEXT J
4240 FOR J= 7 TO 13
4250 IF K(J,A)< 0 THEN LOCATE J+4,4* (A- 1)+ 15:PRINT "  0":GOTO 4280
4260 IF K(J,A)< 1 THEN 4280
4270 LOCATE J+4,4* (A- 1)+ 15:PRINT USING "###";K(J,A)
4280 NEXT J
4290 LOCATE 9,4* (A- 1)+ 15:PRINT USING "###";K(15,A)
4300 LOCATE 19,4* (A- 1)+ 15:PRINT USING "###";K(16,A)
4310 LOCATE 20,4* (A- 1)+ 15:PRINT USING "###";K(14,A)
4320 LOCATE 21,4* (A- 1)+ 15:PRINT USING "###";K(17,A)
4330 COLOR 7,0
4340 IF A* CC< > N THEN 1330
4350 REM
4360 REM  RESET M(I) COMPUTER PRIORITIES
4370 REM
4380 FOR B= 1 TO 13
4390 IF M(B)= 12 THEN 4410
4400 IF M(B)= I THEN M(B)= 0
4410 NEXT B
4420 GOTO 1330
4430 REM
4440 REM   INSTRUCTIONS
4450 REM
4460 PRINT "            Y A H T Z E E "
4470 PRINT "THIS IS THE GAME OF YAHTZEE - "
4480 PRINT "FROM 1 TO 7 PLAYERS MAY PLAY AT THE SAME TIME"
4490 PRINT "WITH EACH PLAYERS CURRENT STATUS SHOWN ON THE"
4500 PRINT "PLAYING BOARD, INCLUDING TOTAL SCORES"
4510 PRINT
4520 PRINT "THE ONLY DIFFERENCE BETWEEN THIS GAME AND THE"
4530 PRINT "POPULAR HOME GAME IS THAT YOU MAY GET MULTIPLE"
4540 PRINT "YAHTZEES HERE ..... THE FIRST YAHTZEE SCORES"
4550 PRINT "50 POINTS, AND EACH ADDITIONAL ONE WILL YIELD"
4560 PRINT "A BONUS OF 100 POINTS (IF THE YAHTZEE IS PUT"
4570 PRINT "INTO THE YAHTZEE BLOCK)..... IN ADDITION YOU"
4580 PRINT "WILL BE GIVEN AN EXTRA TURN AT THE END OF"
4590 PRINT "THE GAME":PRINT :PRINT
4600 PRINT "THE WINNER WILL BE ANNOUNCED AT THE END OF"
4610 PRINT "THE GAME - - BUT I WOULDNT ADVISE ANYONE"
4620 PRINT "TO BE LAST......."
4630 PRINT:PRINT
4640 GOSUB 2090:INPUT "HIT RETURN TO CONTINUE  ";Y$:BEEP
4650 RETURN
4660 RETURN
4670 LOCATE 10,10:PRINT "YATZEE.BAS     VER 3.2"
4680 LOCATE 12,10:PRINT "27 JUN 79"
4690 LOCATE 14,10:PRINT "DEVELOPED BY"
4700 LOCATE 15,13:PRINT "J.L. HELMS    &    M.F. PEZOK"
4710 LOCATE,16,13:PRINT "1009 LEYTE RD / 1321 SAIPAN RD"
4720 LOCATE 17,17:PRINT "CORONADO,  CA.  92118"
4730 LOCATE 18,15:PRINT "[phone] / 437-4659"
4740 PRINT CHR$(11)
4750 RETURN
4760 REM
4770 REM   END - SORT WINNER
4780 REM
4790 X= 2:IF N= 1 THEN 4870
4800 FOR J= 1 TO N- 1
4810 IF K(17,J)> K(17,J+ 1)THEN 4850
4820 K= K(17,J):K(17,J)= K(17,J+ 1):K(17,J+ 1)= K
4830 A$= A$(J):A$(J)= A$(J+ 1):A$(J+ 1)= A$
4840 X= 1
4850 NEXT J
4860 ON X GOTO 4760,4870
4870 REM
4880 REM   PRINT WINNERS STANDINGS
4890 REM
4900 RESTORE 5200
4910 FOR J= 1 TO N
4920 LOCATE 25,1:PRINT STRING$(60," ");
4930 IF J> 1 AND J= N THEN RESTORE 5240
4940 LOCATE 25,1:READ A$
4950 PRINT A$;"     ";A$(J);" ";
4960 TT= 500* (N- J+ 1):IF TT< 1500 THEN TT= 1500
4970 FOR T= 1 TO TT:NEXT T
4980 NEXT J
4990 LOCATE 25,1:PRINT STRING$(60," ");
5000 LOCATE 24,1:PRINT "+++   END OF GAME   +++";
5010 FOR T= 1 TO 2000:NEXT T
5020 '
5030 GOSUB 2090:LOCATE 25,1:INPUT "PLAY AGAIN?  Y/N  ";Y$
5040 IF LEFT$ (Y$,1)= "Y"THEN GOSUB 5090:GOTO 1110
5050 IF LEFT$ (Y$,1)= CHR$(27) THEN BEEP:GOTO 5070
5060 IF LEFT$ (Y$,1)< > "N"THEN BEEP:GOTO 5030
5070 GOTO 65200
5080 END
5090 REM
5100 REM   CLEAR MATRICES
5110 REM
5120 FOR K= 1 TO 7
5130 FOR J= 1 TO 18
5140 K(J,K)= 0
5150 NEXT J
5160 A$(K)= ""
5170 NEXT K
5180 CLS
5190 RETURN
5200 DATA "+++   THE WINNER   +++"
5210 DATA " SECOND PLACE"," THIRD PLACE "
5220 DATA " FOURTH PLACE "," FIFTH PLACE "
5230 DATA " SIXTH PLACE "
5240 DATA " DEAD LAST "
5250 REM
5260 REM   ERASE DIE
5270 REM
5280 COLOR 0,7:PRINT"";:
5290 LOCATE 4* J+ 1,50:PRINT"       ";
5300 LOCATE 4* J+ 2,50:PRINT"       ";
5310 LOCATE 4* J+ 3,50:PRINT"       ";
5320 COLOR 7,0
5330 RETURN
5340 REM
5350 REM    CHECK IF DONE
5360 REM
5370 X= 0
5380 FOR J= 1 TO N
5390 Y= 2
5400 FOR K= 1 TO 13
5410 IF K(K,J)= 0 THEN Y= 1
5420 NEXT K
5430 K(18,J)= Y
5440 IF Y= 2 THEN X= X+ 1
5450 NEXT J
5460 IF X= > N THEN A= 0
5470 RETURN
5480 REM
5490 REM  COMPUTER PRIORITIES INFO
5500 REM
5510 GOSUB 6780
5520 RETURN
5530 REM
5540 REM   PRINT DIE
5550 REM
5560 COLOR 0,7:LOCATE ,,0
5570 REM
5580 PLAY "L32T200N=TN(DIE);"
5590 ON DIE GOTO 5930,5870,5810,5750,5690,5630
5600 '
5610 '   SIX
5620 '
5630 LOCATE 4*J+1,50:PRINT "";CHR$(32);CHR$(2);CHR$(32);CHR$(2);CHR$(32);CHR$(2);CHR$(32);
5640 LOCATE 4*J+2,50:PRINT CHR$(32);CHR$(32);CHR$(32);CHR$(32);CHR$(32);CHR$(32);CHR$(32);
5650 LOCATE 4*J+3,50:PRINT CHR$(32);CHR$(2);CHR$(32);CHR$(2);CHR$(32);CHR$(2);CHR$(32);:GOTO 5960
5660 '
5670 '   FIVE
5680 '
5690 LOCATE 4*J+1,50:PRINT "";CHR$(32);CHR$(2);CHR$(32);" ";CHR$(32);CHR$(2);" ";
5700 LOCATE 4*J+2,50:PRINT " ";CHR$(32);" ";CHR$(2);" ";CHR$(32);" ";
5710 LOCATE 4*J+3,50:PRINT " ";CHR$(2);" ";CHR$(32);" ";CHR$(2);" ";:GOTO 5960
5720 '
5730 '   FOUR
5740 '
5750 LOCATE 4*J+1,50:PRINT "";" ";CHR$(2);"  ";CHR$(32);CHR$(2);" ";
5760 LOCATE 4*J+2,50:PRINT "   ";CHR$(32);CHR$(32);CHR$(32);
5770 LOCATE 4*J+3,50:PRINT " ";CHR$(2);"  ";CHR$(32);CHR$(2);" ";:GOTO 5960
5780 '
5790 '   THREE
5800 '
5810 LOCATE 4*J+1,50:PRINT "";" ";CHR$(2);"     ";
5820 LOCATE 4*J+2,50:PRINT "   ";CHR$(2);"   ";
5830 LOCATE 4*J+3,50:PRINT "     ";CHR$(2);" ";:GOTO 5960
5840 '
5850 '   TWO
5860 '
5870 LOCATE 4*J+1,50:PRINT "";" ";CHR$(2);"     ";
5880 LOCATE 4*J+2,50:PRINT "       ";
5890 LOCATE 4*J+3,50:PRINT "     ";CHR$(2);" ";:GOTO 5960
5900 '
5910 '   ONE
5920 '
5930 LOCATE 4*J+1,50:PRINT "";"       ";
5940 LOCATE 4*J+2,50:PRINT "   ";CHR$(2);"   ";
5950 LOCATE 4*J+3,50:PRINT "       ";:GOTO 5960
5960 REM   GET OUT
5970 COLOR 7,0
5980 LOCATE 1,1
5990 RETURN
6000 REM
6010 REM  COMPUTER OPTION
6020 REM
6030 CC= 0
6040 LOCATE 25,1
6050 PRINT "DO YOU WISH TO PLAY AGAINST ME?  Y/N  ";:GOSUB 2090
6060 Y$=INKEY$:IF Y$="" THEN 6060 ELSE BEEP
6070 IF Y$= "N"THEN RETURN
6080 IF Y$< > "Y"THEN 6040
6090 CC= 1
6100 RETURN
6110 REM
6120 REM  CHECK FOR ACES-SIXES ANY POSITION
6130 REM
6140 X= - 1
6150 FOR J= 0 TO 4
6160 IF S(0,J)= I THEN X= J
6170 NEXT J
6180 RETURN
6190 REM
6200 REM  TOTAL DICE VALUE
6210 REM
6220 FOR J= 1 TO 5
6230 K(I,A)= K(I,A)+ C(J)
6240 NEXT J
6250 RETURN
6260 REM
6270 REM  MATRIX INFORMATION
6280 REM
6290 REM  C(5)     CURRENT DICE
6300 REM  K(18,7)  SCOREBOARD
6310 REM           COLUMNS 1-13 BOARD NUMBER
6320 REM           COLUMN    14 BONUS UPPER
6330 REM           COLUMN    15 TOTAL UPPER
6340 REM           COLUMN    16 TOTAL LOWER
6350 REM           COLUMN    17 GRAND TOTAL
6360 REM           COLUMN    18 DONE/NOT DONE STATUS
6370 REM           ROW     1- 7 PLAYERS SCORE
6380 REM           ROW        N COMPUTERS SCORE (<7 PLAYERS)
6390 REM
6400 REM  F(5)     DICE NUMBER TO ROLL AGAIN
6410 REM  A$(7)    PLAYERS NAMES
6420 REM  S(6,5)   COMPUTERS DICE LOGIC
6430 REM           COLUMN     0 DICE NUMBER BY QTY SEQUENCE
6440 REM           COLUMN     1 QTY/POSITION FOR ACES
6450 REM           COLUMN     2 QTY/POSITION FOR TWOS
6460 REM           COLUMN     3 QTY/POSITION FOR THREES
6470 REM           COLUMN     4 QTY/POSITION FOR FOURS
6480 REM           COLUMN     5 QTY/POSITION FOR FIVES
6490 REM           COLUMN     6 QTY/POSITION FOR SIXES
6500 REM           ROW        0 QUANTITY OF DICE
6510 REM           ROW     1- 5 POSITION OF DICE IN C(5)
6520 REM
6530 REM  SAMPLE S(Y,X) FOR DICE OF 5,2,4,6,4
6540 REM
6550 REM  Y/X   0  1  2  3  4  5
6560 REM  0     4  6  5  2          IN QTY/VALUE SEQUENCE
6570 REM  1                         NO DIE=1
6580 REM  2     1  2                1 TWO POSITION 2
6590 REM  3                         NO DIE=3
6600 REM  4     2  3  5             2 FOURS POSITIONS 3 AND 5
6610 REM  5     1  1                1 FIVE POSITION 1
6620 REM  6     1  4                1 SIX POSITION 4
6630 REM           +           +
6640 REM  +     +  ++++++++++++++++ SECTION FOR POSITION DATA
6650 REM  +     +------------------ COLUMN INDICATES QTY
6660 REM  +------------------------ INDEX EQUATES TO DIE VALUE
6670 REM
6680 REM  M(13)    PRIORITY NUMBERS FOR MUST SCORE WHERE VALUE
6690 REM           REFERS TO PLAY BOARD NUMBER
6700 REM
6710 REM  TO RUN INTERNAL CHECKS SECTION - ENTER A -1 FOR
6720 REM  PLAYING BOARD NUMBER OR QTY OF DICE TO ROLL
6730 REM  AGAIN - - DATA WILL NOT BE LOST AND SCREEN
6740 REM  WILL BE RESET WITH CURRENT DICE SHOWN - -
6750 REM  PLAYERS/COMPUTERS SCORE WILL NOT SHOW UNTIL
6760 REM  AFTER THEIR TURN
6770 REM
6780 REM  COMPUTER PRIORIRIES
6790 RESTORE 6800
6800 DATA 11,9,12,8,1,2,3,4,5,6,10,7,13
6810 FOR Y= 1 TO 13:READ M(Y):NEXT :RETURN :RETURN
6820 REM player's board
6830 LOCATE 25,1,0:COLOR 7,0:CLS:COLOR 5,3:LOCATE 1,1:FOR Y=1 TO 22:PRINT STRING$(80," ");:NEXT:LOCATE 1,1
6840 PRINT"             ╒═══╤═══╤═══╤═══╤═══╤═══╕
6850 PRINT"ACES........1│...│...│...│...│...│...│1"
6860 PRINT"TWOS........2│...│...│...│...│...│...│2"
6870 PRINT"THREES......3│...│...│...│...│...│...│3"
6880 PRINT"FOURS.......4│...│...│...│...│...│...│4"
6890 PRINT"FIVES.......5│...│...│...│...│...│...│5"
6900 PRINT"SIXES.......6│...│...│...│...│...│...│6"
6910 PRINT"             ╞═══╪═══╪═══╪═══╪═══╪═══╡"
6920 PRINT"TOTAL UPPER..│...│...│...│...│...│...│"
6930 PRINT"             ╞═══╪═══╪═══╪═══╪═══╪═══╡"
6940 PRINT"3 OF A KIND.7│...│...│...│...│...│...│7"
6950 PRINT"4 OF A KIND.8│...│...│...│...│...│...│8"
6960 PRINT"FULL HOUSE..9│...│...│...│...│...│...│9"
6970 PRINT"SM STRAIGHT.A│...│...│...│...│...│...│A"
6980 PRINT"LG STRAIGHT.B│...│...│...│...│...│...│B"
6990 PRINT"YATZEE......C│...│...│...│...│...│...│C"
7000 PRINT"CHANCE......D│...│...│...│...│...│...│D"
7010 PRINT"             ╞═══╪═══╪═══╪═══╪═══╪═══╡"
7020 PRINT"TOTAL LOWER..│...│...│...│...│...│...│"
7030 PRINT"TOP BONUS....│...│...│...│...│...│...│"
7040 PRINT"GRAND TOTAL..│...│...│...│...│...│...│"
7050 PRINT"             ╘═══╧═══╧═══╧═══╧═══╧═══╛"
7060 FOR N=1 TO 5:LOCATE N*4-2,46:PRINT N;:NEXT
7070 RETURN
7080 LOCATE 25,1:PRINT STRING$(70," ");:LOCATE 25,1:RETURN
7090 ' KB INPUT AND ESCAPE
7100 KB$="":WHILE KB$="":KB$=INKEY$:WEND
7110 IF KB$=CHR$(27) THEN 5070 ELSE RETURN
65000 REM -*- program name -*-
65010 REM Version 1.00
65020 KEY(2) ON:ON KEY(2) GOSUB 65200
65030 KEY OFF:SCREEN 0,1:COLOR 15,3,1:WIDTH 40:CLS:LOCATE 5,18:PRINT " IBM "
65040 LOCATE 7,12,0:PRINT "Personal Computer"
65050 COLOR 10,0:LOCATE 10,9,0:PRINT CHR$(213)+STRING$(21,205)+CHR$(184)
65060 LOCATE 11,9,0:PRINT CHR$(179)+" -*-   YAHTZEE   -*- "+CHR$(179)
65070 LOCATE 12,9,0:PRINT CHR$(179)+STRING$(21,32)+CHR$(179)
65080 LOCATE 13,9,0:PRINT CHR$(179)+"By: J Helms & M Pezok"+CHR$(179)
65085 LOCATE 14,9,0:PRINT CHR$(179)+"PC vsn: Patrick Leabo"+CHR$(179)
65090 LOCATE 15,9,0:PRINT CHR$(212)+STRING$(21,205)+CHR$(190)
65100 COLOR 15,0:LOCATE 19,5,0:PRINT "   Original written for CCII   "
65110 COLOR 14,0:LOCATE 23,7,0:PRINT "Press space bar to continue";CHR$(7);
65120 COLOR 30:LOCATE 23,5,0:PRINT CHR$(15);:LOCATE 23,35,0:PRINT CHR$(15);
65130 COLOR 14
65140 POKE 106,0 'CLEAR KYBD BUFFER
65150 CMD$ = INKEY$
65160 IF CMD$="" THEN GOTO 65150
65170 IF CMD$ = CHR$(27) THEN GOTO 65200
65180 IF CMD$ = " " THEN GOTO 1
65190 GOTO 65140
65200 ON ERROR GOTO 65240:RUN"BASMENU
65210 IF E<>71 THEN RUN"control
65220 RUN"A:TRANSFER
65230 SYSTEM
65240 E=ERR:RESUME NEXT